home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 015a / bbb_v21.zip / BET.BAS < prev    next >
BASIC Source File  |  1991-11-25  |  12KB  |  508 lines
  1. ' BET v 1.0 - Brent's Environment Tools
  2. '
  3. ' (c) 1991 by Brent Ashley
  4. '
  5. ' last revision 25 November 1991
  6. '
  7. ' remember to link with _STR$.OBJ under PDQ v3.0
  8. '
  9. ' $include: 'pdqdecl.bas'
  10.  
  11. ' use long integers by default
  12. DEFLNG A-Z
  13. TYPE DTAType
  14.   Rsvd AS STRING * 21
  15.   Attr AS STRING * 1
  16.   TimeStamp AS INTEGER
  17.   DateStamp AS INTEGER
  18.   FileSize AS LONG
  19.   FileName AS STRING * 13
  20. END TYPE
  21.  
  22. DIM ErrorLevel AS INTEGER, Regs AS RegType, DTA AS DTAType
  23.  
  24. ' function to pad a number left with zeros
  25. DEF FNPadL0$(Number,Digits) = RIGHT$(STRING$(Digits,48)+STR$(Number),Digits)
  26.  
  27. CmdLine$ = COMMAND$
  28.  
  29. ' check for help request or no command line
  30. IF CmdLine$ = "" OR CmdLine$ = "/?" THEN 
  31.   PRINT
  32.   PRINT "BET - Brent's Environment Tools v1.0 by Brent Ashley"
  33.   PRINT "Syntax:  BET [/D] ResultVar Action [Value1 [Value2...]] 
  34.   PRINT "    or:  BET [/D] IS Value1 LT/GT/LE/GE/EQ/NE Value2
  35.   PRINT "                          (returns ERRORLEVEL 255=True 0=False)
  36.   PRINT "Where Action is one of:"
  37.   PRINT "--- Math actions:"
  38.   PRINT "  HEX Value1"
  39.   PRINT "  ADD/SUB/MUL/DIV/MOD Value1 Value2"
  40.   PRINT "--- String actions:"
  41.   PRINT "  LEFT/RIGHT TargetVar Characters"
  42.   PRINT "  MID TargetVar Startpos Characters"
  43.   PRINT "  LEN/UPPER/LOWER/LTRIM/RTRIM TargetVar"
  44.   PRINT "  INSTR TargetVar Text"
  45.   PRINT "  APPEND Text"
  46.   PRINT "--- System info actions:"
  47.   PRINT "  CPU/VIDEO/COLOR/MACHINEID/NPX/MOUSE/SERIAL/PARALLEL"
  48.   PRINT "  TIME/HOUR/MINUTE/DATE/WEEKDAY/DAY/MONTH/YEAR"
  49.   PRINT "  DOSVER/MODE/LINES/CURDRIVE/CURDIR/VALIDDRVS/MEM/EXT"
  50.   PRINT "  TOGGLE CAP/NUM/INS/SCR [ON/OFF]"
  51.   PRINT "  VOL DriveLetter"
  52.   END
  53. END IF
  54.  
  55. ' work on parent environment
  56. EnvOption 1
  57. Debug = 0
  58. ErrorLevel = 0
  59.  
  60. ' get result variable name
  61. SetDelimitChar 32 ' space
  62. ResultVar$ = UCASE$(PDQParse(CmdLine$)) 
  63.  
  64. ' check for debug
  65. IF ResultVar$ = "/D" THEN
  66.   Debug = -1
  67.   ResultVar$ = UCASE$(PDQParse(CmdLine$))
  68. END IF
  69.  
  70. '
  71. ' logical comparisons
  72. '
  73. IF ResultVar$ = "IS" THEN
  74.   Value1 = PDQValL(PDQParse(CmdLine$))
  75.   Oper$ = UCASE$(PDQParse(CmdLine$))
  76.   Value2 = PDQValL(PDQParse(CmdLine$))
  77.   SELECT CASE Oper$
  78.     CASE "LT"
  79.       IF Value1 < Value2 THEN ErrorLevel = 255
  80.     CASE "GT"
  81.       IF Value1 > Value2 THEN ErrorLevel = 255
  82.     CASE "LE"
  83.       IF Value1 <= Value2 THEN ErrorLevel = 255
  84.     CASE "GE"
  85.       IF Value1 >= Value2 THEN ErrorLevel = 255
  86.     CASE "EQ"
  87.       IF Value1 = Value2 THEN ErrorLevel = 255
  88.     CASE "NE"
  89.       IF Value1 <> Value2 THEN ErrorLevel = 255
  90.     CASE ELSE
  91.       PRINT "Invalid IS operator: "; Oper$
  92.       ErrorLevel = 1
  93.   END SELECT
  94.   
  95.   IF Debug THEN
  96.     IF ErrorLevel = 255 THEN PRINT "True" ELSE PRINT "False"
  97.   END IF
  98.   EndLevel ErrorLevel
  99. END IF
  100.  
  101. '
  102. ' BET Actions
  103. '
  104. Action$ = UCASE$(PDQParse(CmdLine$))
  105. SELECT CASE Action$
  106.  
  107. '
  108. ' Math actions
  109. '
  110.   CASE "HEX"
  111.     Value1 = PDQValL(PDQParse(CmdLine$))
  112.     Result$ = Hex$(Value1) 
  113.  
  114.   CASE "ADD" 
  115.     GOSUB Get2Vals
  116.     Result$ = STR$(Value1 + Value2)
  117.   
  118.   CASE "SUB"
  119.     GOSUB Get2Vals
  120.     Result$ = STR$(Value1 - Value2)
  121.  
  122.   CASE "MUL"
  123.     GOSUB Get2Vals
  124.     Result$ = STR$(Value1 * Value2)
  125.  
  126.   CASE "DIV"
  127.     GOSUB Get2Vals
  128.     Result$ = STR$(Value1 \ Value2)
  129.  
  130.   CASE "MOD"
  131.     GOSUB Get2Vals
  132.     Result$ = STR$(Value1 MOD Value2)
  133.  
  134. '
  135. ' String actions
  136. '
  137.   CASE "LEN"
  138.     GOSUB GetTargetVar
  139.     StrLen = (LEN(ENVIRON$(TargetVar$)))
  140.     ErrorLevel = StrLen MOD 256
  141.     Result$ = STR$(StrLen)
  142.  
  143.   CASE "INSTR"
  144.     GOSUB GetTargetVar
  145.     SetDelimitChar 13
  146.     Text$ = RTRIM$(PDQParse(CmdLine$))
  147.     FOR i% = 1 TO LEN(Text$)
  148.       IF MID$(Text$,i%,1) = "~" THEN MID$(Text$,i%,1) = " "
  149.     NEXT      
  150.     Posn = INSTR(ENVIRON$(TargetVar$),Text$)
  151.     ErrorLevel = Posn MOD 256
  152.     Result$ = STR$(Posn)
  153.  
  154.   CASE "MID"
  155.     GOSUB GetTargetVar
  156.     StartPos% = PDQValI(PDQParse(CmdLine$))
  157.     Chars% = PDQValI(PDQParse(CmdLine$))
  158.     Result$ = MID$(ENVIRON$(TargetVar$),StartPos%,Chars%)
  159.   
  160.   CASE "UPPER"
  161.     GOSUB GetTargetVar
  162.     Result$ = UCASE$(ENVIRON$(TargetVar$))
  163.  
  164.   CASE "LOWER"
  165.     GOSUB GetTargetVar
  166.     Result$ = LCASE$(ENVIRON$(TargetVar$))
  167.  
  168.   CASE "LEFT"
  169.     GOSUB GetTargetVar
  170.     Value1% = PDQValI(PDQParse(CmdLine$))
  171.     Result$ = LEFT$(ENVIRON$(TargetVar$),Value1%)
  172.  
  173.   CASE "RIGHT"
  174.     GOSUB GetTargetVar
  175.     Value1% = PDQValI(PDQParse(CmdLine$))
  176.     Result$ = RIGHT$(ENVIRON$(TargetVar$),Value1%)
  177.  
  178.   CASE "LTRIM"
  179.     GOSUB GetTargetVar
  180.     Result$ = LTRIM$(ENVIRON$(TargetVar$))
  181.  
  182.   CASE "RTRIM"
  183.     GOSUB GetTargetVar
  184.     Result$ = RTRIM$(ENVIRON$(TargetVar$))
  185.  
  186.   CASE "APPEND"
  187.     SetDelimitChar 13
  188.     Original$ = ENVIRON$(ResultVar$)
  189.     Text$ = PDQParse(CmdLine$)
  190.     Result$ = Original$ + Text$
  191.  
  192. '
  193. ' System Info actions
  194. '
  195.   CASE "CPU"
  196.     Result$ = STR$(GetCpu)
  197.     SELECT CASE Result$
  198.       CASE "86"
  199.         ErrorLevel = 1
  200.       CASE "286"
  201.         ErrorLevel = 2
  202.       CASE "386"
  203.         ErrorLevel = 3
  204.     END SELECT
  205.  
  206.   CASE "VIDEO"
  207.     SELECT CASE PDQMonitor
  208.       CASE 1
  209.         ErrorLevel = 1
  210.         Result$ = "Monochrome"
  211.       CASE 2
  212.         ErrorLevel = 2
  213.         Result$ = "Hercules"
  214.       CASE 3
  215.         ErrorLevel = 3
  216.         Result$ = "CGA"
  217.       CASE 4, 5, 10
  218.         ErrorLevel = 4
  219.         Result$ = "EGA"
  220.       CASE 6, 7
  221.         ErrorLevel = 5
  222.         Result$ = "VGA"
  223.       CASE 8, 9
  224.         ErrorLevel = 6
  225.         Result$ = "MCGA"
  226.       CASE 11
  227.         ErrorLevel = 7
  228.         Result$ = "8514/A"
  229.     END SELECT
  230.  
  231.   CASE "COLOR"
  232.     SELECT CASE PDQMonitor
  233.       CASE 1, 2, 4, 6, 8
  234.         Result$ = "NO"
  235.       CASE ELSE
  236.         Result$ = "YES"
  237.         ErrorLevel = 255
  238.     END SELECT  
  239.  
  240.   CASE "MACHINEID"
  241.     DEF SEG = &HF000
  242.     ErrorLevel = PEEK(&HFFFE)
  243.     Result$ = HEX$(ErrorLevel)
  244.  
  245.   CASE "NPX"
  246.     Result$ = "NO"
  247.     DEF SEG = 0
  248.     IF (PEEK(&H410) AND 2) = 2 THEN
  249.       ERRORLEVEL = 255
  250.       Result$ = "YES"
  251.     END IF
  252.  
  253.   CASE "MOUSE"
  254.     Regs.AX = 0
  255.     Interrupt &H33, Regs
  256.     IF Regs.AX <> 0 Then
  257.       Result$ = "YES"
  258.       ErrorLevel = 255
  259.     ELSE
  260.       Result$ = "NO"
  261.     END IF
  262.  
  263.   CASE "SERIAL"
  264.     DEF SEG = 0
  265.     ErrorLevel = (PEEK(&H411) AND 14)\2
  266.     Result$ = STR$(ErrorLevel)
  267.    
  268.   CASE "PARALLEL"
  269.     DEF SEG = 0
  270.     ErrorLevel = (PEEK(&H411) AND 192)\64
  271.     Result$ = STR$(ErrorLevel)
  272.  
  273.   CASE "TIME"
  274.     GOSUB GetTime
  275.     IF Hour\12 > 0 THEN AMPM$ = "pm" ELSE AMPM$ = "am"
  276.     Hour12 = Hour MOD 12
  277.     IF Hour12 = 0 THEN Hour12 = 12
  278.     Result$ = STR$(Hour12) + ":" + STR$(Minute) + AMPM$
  279.  
  280.   CASE "HOUR"
  281.     GOSUB GetTime
  282.     ErrorLevel = Hour
  283.     Result$ = STR$(ErrorLevel)
  284.  
  285.   CASE "MINUTE"
  286.     GOSUB GetTime
  287.     ErrorLevel = Minute
  288.     Result$ = Str$(ErrorLevel)
  289.  
  290.   CASE "DATE"
  291.     GOSUB GetDate
  292.     Result$=FNPadL0$(Month,2)+"/"+FnPadL0$(Day,2)+"/"+FnPadL0$(Year MOD 100,2)
  293.  
  294.   CASE "WEEKDAY"
  295.     GOSUB GetDate
  296.     ErrorLevel = WeekDay
  297.     SELECT CASE WeekDay
  298.       CASE 0
  299.         Result$ = "Sunday"
  300.       CASE 1
  301.         Result$ = "Monday"
  302.       CASE 2
  303.         Result$ = "Tuesday"
  304.       CASE 3
  305.         Result$ = "Wednesday"
  306.       CASE 4
  307.         Result$ = "Thursday"
  308.       CASE 5
  309.         Result$ = "Friday"
  310.       CASE 6
  311.         Result$ = "Saturday"
  312.     END SELECT
  313.     
  314.   CASE "DAY"
  315.     GOSUB GetDate
  316.     ErrorLevel = Day%
  317.     Result$ = STR$(Day%)
  318.  
  319.   CASE "MONTH"
  320.     GOSUB GetDate
  321.     ErrorLevel = Month%
  322.     SELECT CASE Month%
  323.       CASE 1
  324.         Result$ = "January"
  325.       CASE 2
  326.         Result$ = "February"
  327.       CASE 3
  328.         Result$ = "March"
  329.       CASE 4
  330.         Result$ = "April"
  331.       CASE 5
  332.         Result$ = "May"
  333.       CASE 6
  334.         Result$ = "June"
  335.       CASE 7
  336.         Result$ = "July"
  337.       CASE 8
  338.         Result$ = "August"
  339.       CASE 9
  340.         Result$ = "September"
  341.       CASE 10
  342.         Result$ = "October"
  343.       CASE 11
  344.         Result$ = "November"
  345.       CASE 12
  346.         Result$ = "December"
  347.     END SELECT
  348.  
  349.   CASE "YEAR"
  350.     GOSUB GetDate
  351.     ErrorLevel = Year% MOD 100
  352.     Result$ = STR$(Year%)
  353.  
  354.   CASE "DOSVER"
  355.     DV = DOSVer
  356.     ErrorLevel = DV \ 10
  357.     Result$ = STR$(DV \ 100) + "." + STR$(DV MOD 100)
  358.  
  359.   CASE "MODE"
  360.     Regs.AX = &H0F00
  361.     Interrupt &H10, Regs
  362.     ErrorLevel = Regs.AX MOD 256
  363.     Result$ = STR$(ErrorLevel)
  364.  
  365.   CASE "LINES"
  366.     DEF SEG = 0
  367.     ErrorLevel = PEEK(&H484) + 1
  368.     Result$ = STR$(ErrorLevel)
  369.  
  370.   CASE "CURDRIVE"
  371.     Regs.AX = &H1900
  372.     Interrupt &H21, Regs
  373.     ErrorLevel = Regs.AX MOD 256 + 1
  374.     Result$ = CHR$(64 + ErrorLevel)
  375.  
  376.   CASE "CURDIR"
  377.     Buffer$ = SPACE$(64)
  378.     Regs.AX = &H4700
  379.     Regs.DX = 0
  380.     Regs.DS = VARSEG(Buffer$)
  381.     Regs.SI = SADD(Buffer$)
  382.     Interrupt &H21, Regs
  383.     Result$ = "\"
  384.     NullPos% = INSTR(Buffer$,CHR$(0))
  385.     IF NullPos% > 1 THEN Result$ = Result$ + LEFT$(Buffer$,NullPos% - 1)
  386.  
  387.   CASE "VALIDDRVS"
  388.     DIM DummyFCB AS STRING * 43
  389.     Result$ = ""
  390.     FOR i% = 65 TO 90
  391.       Drive$ = CHR$(i%) + ": "
  392.       Regs.AX = &H2906
  393.       Regs.DS = VARSEG(Drive$)
  394.       Regs.SI = SADD(Drive$)
  395.       Regs.ES = VARSEG(DummyFCB)
  396.       Regs.DI = VARPTR(DummyFCB) + 7
  397.       Interrupt &H21, Regs
  398.       IF (Regs.AX AND 255) <> 255 THEN Result$ = Result$ + CHR$(i%)
  399.     NEXT
  400.  
  401.   CASE "VOL"
  402.     DriveLetter$ = LEFT$(PDQParse$(CmdLine$),1)
  403.     ' Set DTA
  404.     Regs.AX = &H1A00
  405.     Regs.DS = VARSEG(DTA)
  406.     Regs.DX = VARPTR(DTA)
  407.     Interrupt &H21, Regs
  408.     ' Get Label
  409.     Label$ = DriveLetter$ + ":\*.*" + CHR$(0)
  410.     Regs.AX = &H4E00
  411.     Regs.DS = VARSEG(Label$)
  412.     Regs.DX = SADD(Label$)
  413.     Regs.CX = 8
  414.     Interrupt &H21, Regs
  415.     Label$ = DTA.FileName
  416.     ' remove dot
  417.     DotPos% = INSTR(Label$,".")
  418.     IF DotPos% > 0 THEN
  419.       Label$=LEFT$(Label$,DotPos%-1)+RIGHT$(Label$,LEN(Label$)-DotPos%)
  420.     ENDIF    
  421.     Result$ = Label$
  422.  
  423.   CASE "MEM"
  424.     DEF SEG = 0
  425.     Memory = PEEK(&H413) + 256 * PEEK(&H414) 
  426.     Result$ = STR$(Memory)
  427.  
  428.   CASE "EXT"
  429.     Regs.AX = &H8800
  430.     Interrupt &H15, Regs
  431.     Memory% = Regs.AX
  432.     Result$ = STR$(Memory%)
  433.  
  434.   CASE "TOGGLE"
  435.     SELECT CASE UCASE$(PDQParse(CmdLine$))
  436.       CASE "INS"
  437.         Mask = 128
  438.       CASE "CAP"
  439.         Mask = 64
  440.       CASE "NUM"  
  441.         Mask = 32
  442.       CASE "SCR"
  443.         Mask = 16
  444.       CASE ELSE
  445.         PRINT "BET - no toggle specified"
  446.         EndLevel 1
  447.     END SELECT
  448.     DEF SEG = 0
  449.     Kbd = &H417
  450.     SELECT CASE UCASE$(PDQParse(CmdLine$))
  451.       CASE "ON"
  452.         POKE Kbd, PEEK(Kbd) OR Mask
  453.         ResultVar$ = "DUMMY"
  454.       CASE "OFF"
  455.         POKE Kbd, PEEK(Kbd) AND (255 - Mask)
  456.         ResultVar$ = "DUMMY"
  457.       CASE ELSE
  458.         IF PEEK(Kbd) AND Mask THEN
  459.           Result$ = "YES"
  460.           ErrorLevel = 255
  461.         ELSE
  462.           Result$ = "NO"
  463.         END IF
  464.     END SELECT
  465.  
  466.  
  467.   CASE ELSE
  468.     PRINT "Invalid BET command: "; Action$
  469.     ErrorLevel = 1
  470.  
  471. END SELECT
  472. IF Debug THEN 
  473.   PRINT ResultVar$;" : "; Result$
  474.   PRINT "ErrorLevel : "; ErrorLevel
  475. ENDIF
  476. IF ResultVar$ <> "DUMMY" THEN 
  477.   ENVIRON ResultVar$ + "=" + Result$
  478. END IF
  479. EndLevel ErrorLevel
  480.  
  481. '
  482. ' Subroutines
  483. '
  484. Get2Vals:
  485.   Value1 = PDQValL(PDQParse(CmdLine$))
  486.   Value2 = PDQValL(PDQParse(CmdLine$))
  487.   RETURN
  488.  
  489. GetTargetVar:
  490.   TargetVar$ = UCASE$(PDQParse(CmdLine$))
  491.   RETURN
  492.  
  493. GetTime:
  494.   Regs.AX = &H2C00
  495.   Interrupt &H21, Regs
  496.   Hour = Regs.CX \ 256
  497.   Minute = Regs.CX MOD 256
  498.   RETURN
  499.  
  500. GetDate:
  501.   Regs.AX = &H2A00
  502.   Interrupt &H21, Regs
  503.   Year% = Regs.CX
  504.   Month% = Regs.DX \ 256
  505.   Day% = Regs.DX MOD 256
  506.   WeekDay% = Regs.AX MOD 7
  507.   RETURN
  508.